home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
lisp
/
kcl
/
akcl
/
akcl1615.lha
/
V
/
lsp
/
seqlib.lsp
< prev
next >
Wrap
Lisp/Scheme
|
1989-08-31
|
17KB
|
777 lines
Changes file for /usr/local/src/kcl/lsp/seqlib.lsp
Created on Thu Aug 31 10:03:04 1989
Usage \n@s[Original text\n@s|Replacement Text\n@s]
See the file rascal.ics.utexas.edu:/usr2/ftp/merge.c
for a program to merge change files. Anything not between
"\n@s[" and "\n@s]" is a simply a comment.
This file was constructed using emacs and merge.el
Enhancements Copyright (c) W. Schelter All rights reserved.
by (Bill Schelter) wfs@carl.ma.utexas.edu
****Change:(orig (46 49 d))
@s[(proclaim '(function check-seq-test (t t) t))
(defun check-seq-test (test test-not)
(when (and test test-not)
(error "Both :TEST and :TEST-NOT were specified.")))
@s|
@s]
****Change:(orig (58 65 c))
@s[(proclaim '(function check-seq-args (t t t t) t))
(defun check-seq-args (test test-not start end)
(when (and test test-not)
(error "Both :TEST and :TEST-NOT were specified."))
@s, (error "START is greater than END.")))
@s|(proclaim '(function test-error() t))
(defun test-error()
(error "both test and test not supplied"))
@s]
****Change:(orig (66 66 a))
@s[
@s|
(defun bad-seq-limit (x &optional y)
(error "bad sequence limit ~a" (if y (list x y) x)))
@s]
****Change:(orig (67 67 a))
@s[
@s|
(eval-when (compile eval)
(proclaim '(function the-start (t) fixnum))
(proclaim '(function the-end (t t) fixnum))
(defmacro f+ (x y) `(the fixnum (+ (the fixnum ,x) (the fixnum ,y))))
(defmacro f- (x y) `(the fixnum (- (the fixnum ,x) (the fixnum ,y))))
(defmacro with-start-end ( start end seq &body body)
`(let ((,start (if ,start (the-start ,start) 0)))
(declare (fixnum ,start))
(let ((,end (the-end ,end ,seq)))
(declare (fixnum ,end))
(or (<= ,start ,end) (bad-seq-limit ,start ,end))
,@ body)))
)
(defun the-end (x y)
(cond ((fixnump x)
(or (<= (the fixnum x) (the fixnum (length y)))
(bad-seq-limit x))
x)
((null x)
(length y))
(t (bad-seq-limit x))))
(defun the-start (x)
(cond ((fixnump x)
(or (>= (the fixnum x) 0)
(bad-seq-limit x))
(the fixnum x))
((null x) 0)
(t (bad-seq-limit x))))
@s]
****Change:(orig (70 71 c))
@s[ (start 0)
(end (length sequence))
@s| start
end
@s]
****Change:(orig (73 76 c))
@s[ (check-seq-start-end start end)
(let ((start start) (end end))
(declare (fixnum start end))
(cond ((not from-end)
@s| (with-start-end start end sequence
(cond ((not from-end)
@s]
****Change:(orig (81 81 c))
@s[ (incf start))
@s| (setf start (f+ 1 start))
)
@s]
****Change:(orig (84 84 c))
@s[ (incf start)))))
@s| (setf start (f+ 1 start))
))))
@s]
****Change:(orig (90 90 c))
@s[ (decf end)
@s| (setf end (f+ end -1))
@s]
****Change:(orig (94 94 c))
@s[ (decf end))))))
@s| (setf end (f+ -1 end)))))))
@s]
****Change:(orig (98 105 c))
@s[ &key (start 0) (end (length sequence)))
(check-seq-start-end start end)
(let ((start start) (end end))
(declare (fixnum start end))
@s, (setf (elt sequence i) item))))
@s| &key start end )
(with-start-end start end sequence
(do ((i start (f+ 1 i)))
((>= i end) sequence)
(declare (fixnum i))
(setf (elt sequence i) item))))
@s]
****Change:(orig (109 114 c))
@s[ &key (start1 0) (end1 (length sequence1))
(start2 0) (end2 (length sequence2)))
(check-seq-start-end start1 end1)
(check-seq-start-end start2 end2)
@s, (declare (fixnum start1 end1 start2 end2))
@s| &key start1 end1
start2 end2 )
(with-start-end start1 end1 sequence1
(with-start-end start2 end2 sequence2
@s]
****Change:(orig (117 123 c))
@s[ (do* ((i 0 (1+ i))
(l (if (< (the fixnum (- end1 start1))
(the fixnum (- end2 start2)))
(the fixnum (- end1 start1))
@s, (s2 (+ start2 (the fixnum (1- l))) (1- s2)))
@s| (do* ((i 0 (f+ 1 i))
(l (if (< (f- end1 start1)
(f- end2 start2))
(f- end1 start1)
(f- end2 start2)))
(s1 (f+ start1 (f+ -1 l)) (f+ -1 s1))
(s2 (f+ start2 (f+ -1 l)) (f+ -1 s2)))
@s]
****Change:(orig (127 133 c))
@s[ (do ((i 0 (1+ i))
(l (if (< (the fixnum (- end1 start1))
(the fixnum (- end2 start2)))
(the fixnum (- end1 start1))
@s, (s2 start2 (1+ s2)))
@s| (do ((i 0 (f+ 1 i))
(l (if (< (f- end1 start1)
(f- end2 start2))
(f- end1 start1)
(f- end2 start2)))
(s1 start1 (f+ 1 s1))
(s2 start2 (f+ 1 s2)))
@s]
****Change:(orig (136 136 c))
@s[ (setf (elt sequence1 s1) (elt sequence2 s2))))))
@s| (setf (elt sequence1 s1) (elt sequence2 s2)))))))
@s]
****Change:(orig (155 156 c))
@s[ (iterate-i '(i start (1+ i)))
(iterate-i-from-end '(i (1- end) (1- i)))
@s| (iterate-i '(i start (f+ 1 i)))
(iterate-i-from-end '(i (f+ -1 end) (f+ -1 i)))
@s]
****Change:(orig (159 160 c))
@s[ (iterate-i-everywhere '(i 0 (1+ i)))
(iterate-i-everywhere-from-end '(i (1- l) (1- i)))
@s| (iterate-i-everywhere '(i 0 (f+ 1 i)))
(iterate-i-everywhere-from-end '(i (f+ -1 l) (f+ -1 i)))
@s]
****Change:(orig (176 176 c))
@s[ (kount-up '(setq k (1+ k))))
@s| (kount-up '(setq k (f+ 1 k))))
@s]
****Change:(orig (179 180 c))
@s[ (start 0) (end (length sequence))
,@(if countp '((count (length sequence))))
@s| start end
,@(if countp '(count))
@s]
****Change:(orig (184 184 a))
@s[ nil))
@s| nil))
,@(if everywherep '((declare (fixnum l))))
(with-start-end start end sequence
(let ,@(if countp
'(((count (if (null count)
most-positive-fixnum count)))))
@s]
****Change:(orig (186 189 c))
@s[ ,@(if everywherep '((declare (fixnum l))))
(check-seq-args test test-not start end)
(let ((start start) (end end))
(declare (fixnum start end))
@s| nil
(and test test-not (test-error))
@s]
****Change:(orig (199 199 c))
@s[ (eval-body))))))
@s| (eval-body)))))))
@s]
****Change:(orig (204 205 c))
@s[ (start 0) (end (length sequence))
,@(if countp '((count (length sequence))))
@s| start end
,@(if countp '(count))
@s]
****Change:(orig (216 218 c))
@s[ &key from-end
(start 0) (end (length sequence))
,@(if countp '((count (length sequence))))
@s| &key from-end start end
,@(if countp '(count))
@s]
****Change:(orig (236 236 c))
@s[ (do ((i 0 (1+ i)))
@s| (do ((i 0 (f+ 1 i)))
@s]
****Change:(orig (241 241 c))
@s[ (do ((i start (1+ i)) (j 0))
@s| (do ((i start (f+ 1 i)) (j 0))
@s]
****Change:(orig (246 246 c))
@s[ (incf j)
@s| (setf j (f+ 1 j))
@s]
****Change:(orig (269 269 c))
@s[ (do ((i 0 (1+ i)))
@s| (do ((i 0 (f+ 1 i)))
@s]
****Change:(orig (273 273 c))
@s[ (do ((i start (1+ i)) (j 0))
@s| (do ((i start (f+ 1 i)) (j 0))
@s]
****Change:(orig (277 277 c))
@s[ (incf j)
@s| (setf j (f+ 1 j))
@s]
****Change:(orig (285 285 c))
@s[ (the fixnum (- l count))))
@s| (the fixnum (f- l count))))
@s]
****Change:(orig (287 287 c))
@s[ (j start)
@s| (j 0)
@s]
****Change:(orig (294 294 c))
@s[ (incf j))))))
@s| (setf j (f+ 1 j)))))))
@s]
****Change:(orig (299 299 c))
@s[ (make-sequence (seqtype sequence) (the fixnum (- l count))))
@s| (make-sequence (seqtype sequence) (the fixnum (f- l count))))
@s]
****Change:(orig (301 301 c))
@s[ (j (- (the fixnum (1- end)) n))
@s| (j (f- (the fixnum (f+ -1 end)) n))
@s]
****Change:(orig (308 308 c))
@s[ (decf j)))))))
@s| (setq j (f+ -1 j))))))))
@s]
****Change:(orig (365 366 c))
@s[ (start 0 startsp)
(end (length sequence) endsp)
@s| start end
@s]
****Change:(orig (368 369 c))
@s[ (check-seq-args test test-not start end)
(when (and (listp sequence) (not from-end) (not startsp) (not endsp))
@s| (and test test-not (test-error))
(when (and (listp sequence) (not from-end) (null start)
(null end))
@s]
****Change:(orig (388 389 c))
@s[ (start 0 startsp)
(end (length sequence) endsp)
@s| start
end
@s]
****Change:(orig (393 394 c))
@s[ (check-seq-args test test-not start end)
(when (and (listp sequence) (not from-end) (not startsp) (not endsp))
@s| (and test test-not (test-error))
(when (and (listp sequence) (not from-end) (null start)
(null end))
@s]
****Change:(orig (405 406 c))
@s[ (let ((start start) (end end))
(declare (fixnum start end))
@s| (with-start-end start end sequence
@s]
****Change:(orig (409 409 c))
@s[ (i start (1+ i)))
@s| (i start (f+ 1 i)))
@s]
****Change:(orig (412 413 c))
@s[ (the fixnum (- l n))))
(i 0 (1+ i))
@s| (the fixnum (f- l n))))
(i 0 (f+ 1 i))
@s]
****Change:(orig (423 423 c))
@s[ :start (the fixnum (1+ i))
@s| :start (the fixnum (f+ 1 i))
@s]
****Change:(orig (428 428 c))
@s[ (incf j)))))
@s| (setf j (f+ 1 j))))))
@s]
****Change:(orig (434 434 c))
@s[ :start (the fixnum (1+ i))
@s| :start (the fixnum (f+ 1 i))
@s]
****Change:(orig (437 437 c))
@s[ (incf n)))
@s| (setf n (f+ 1 n))))
@s]
****Change:(orig (439 439 c))
@s[ (i (1- end) (1- i)))
@s| (i (f+ -1 end) (f+ -1 i)))
@s]
****Change:(orig (442 444 c))
@s[ (the fixnum (- l n))))
(i (1- l) (1- i))
(j (- (the fixnum (1- l)) n)))
@s| (the fixnum (f- l n))))
(i (f+ -1 l) (f+ -1 i))
(j (f- (the fixnum (f+ -1 l)) n)))
@s]
****Change:(orig (459 459 c))
@s[ (decf j)))))
@s| (setq j (f+ -1 j))))))
@s]
****Change:(orig (469 469 c))
@s[ (incf n))))))
@s| (setf n (f+ 1 n)))))))
@s]
****Change:(orig (475 483 c))
@s[ (start1 0)
(start2 0)
(end1 (length sequence1))
(end2 (length sequence2)))
@s, (declare (fixnum start1 end1 start2 end2))
@s| start1 start2
end1 end2)
(and test test-not (test-error))
(with-start-end start1 end1 sequence1
(with-start-end start2 end2 sequence2
@s]
****Change:(orig (485 486 c))
@s[ (do ((i1 start1 (1+ i1))
(i2 start2 (1+ i2)))
@s| (do ((i1 start1 (f+ 1 i1))
(i2 start2 (f+ 1 i2)))
@s]
****Change:(orig (494 495 c))
@s[ (do ((i1 (1- end1) (1- i1))
(i2 (1- end2) (1- i2)))
@s| (do ((i1 (f+ -1 end1) (f+ -1 i1))
(i2 (f+ -1 end2) (f+ -1 i2)))
@s]
****Change:(orig (497 497 c))
@s[ (if (and (< i1 start1) (< i2 start2)) nil i1))
@s| (if (and (< i1 start1) (< i2 start2)) nil (f+ 1 i1)))
@s]
****Change:(orig (502 502 c))
@s[ (return i1))))))
@s| (return (f+ 1 i1))))))))
@s]
****Change:(orig (508 516 c))
@s[ (start1 0)
(start2 0)
(end1 (length sequence1))
(end2 (length sequence2)))
@s, (declare (fixnum start1 end1 start2 end2))
@s| start1 start2
end1 end2)
(and test test-not (test-error))
(with-start-end start1 end1 sequence1
(with-start-end start2 end2 sequence2
@s]
****Change:(orig (519 520 c))
@s[ (do ((i1 start1 (1+ i1))
(i2 start2 (1+ i2)))
@s| (do ((i1 start1 (f+ 1 i1))
(i2 start2 (f+ 1 i2)))
@s]
****Change:(orig (528 528 c))
@s[ (incf start2))
@s| (setf start2 (f+ 1 start2)))
@s]
****Change:(orig (530 532 c))
@s[ (do ((i1 (1- end1) (1- i1))
(i2 (1- end2) (1- i2)))
((< i1 start1) (return-from search (the fixnum (1+ i2))))
@s| (do ((i1 (f+ -1 end1) (f+ -1 i1))
(i2 (f+ -1 end2) (f+ -1 i2)))
((< i1 start1) (return-from search (the fixnum (f+ 1 i2))))
@s]
****Change:(orig (539 539 c))
@s[ (decf end2)))))
@s| (setq end2 (f+ -1 end2)))))))
@s]
****Change:(orig (563 563 c))
@s[ (do ((j 1 (1+ j)) (l1 l (cdr l1)))
@s| (do ((j 1 (f+ 1 j)) (l1 l (cdr l1)))
@s]
****Change:(orig (621 621 c))
@s[(proclaim '(function quick-sort (t fixnum fixnum t t)))
@s|(proclaim '(function quick-sort (t fixnum fixnum t t) t))
@s]
****Change:(orig (623 653 c))
@s[(defun quick-sort (sequence start end predicate key &aux (j 0) (k 0))
(declare (fixnum start end j k))
(when (<= end (the fixnum (1+ start)))
(return-from quick-sort sequence))
@s, (quick-sort sequence j end predicate key)
sequence)
@s|(defun quick-sort (seq start end pred key)
(declare (fixnum start end))
(if (<= end (the fixnum (f+ 1 start)))
seq
(let* ((j start) (k end) (d (elt seq start)) (kd (funcall key d)))
(declare (fixnum j k))
(block outer-loop
(loop (loop (setq k (f+ -1 k))
(unless (< j k) (return-from outer-loop))
(when (funcall pred (funcall key (elt seq k)) kd)
(return)))
(loop (setf j (f+ 1 j))
(unless (< j k) (return-from outer-loop))
(unless (funcall pred (funcall key (elt seq j)) kd)
(return)))
(let ((temp (elt seq j)))
(setf (elt seq j) (elt seq k)
(elt seq k) temp))))
(setf (elt seq start) (elt seq j)
(elt seq j) d)
(quick-sort seq start j pred key)
(quick-sort seq (f+ 1 j) end pred key))))
@s]
****Change:(orig (655 655 d))
@s[
@s|
@s]
****Change:(orig (671 672 c))
@s[ (do ((newseq (make-sequence result-type (the fixnum (+ l1 l2))))
(j 0 (1+ j))
@s| (do ((newseq (make-sequence result-type (the fixnum (f+ l1 l2))))
(j 0 (f+ 1 j))
@s]
****Change:(orig (682 682 c))
@s[ (setf (elt newseq j) (elt sequence1 i1))
(incf i1))
@s| (setf (elt newseq j) (elt sequence1 i1))
(setf i1 (f+ 1 i1)))
@s]
****Change:(orig (687 687 c))
@s[ (setf (elt newseq j) (elt sequence2 i2))
(incf i2))
@s| (setf (elt newseq j) (elt sequence2 i2))
(setf i2 (f+ 1 i2)))
@s]
****Change:(orig (690 690 c))
@s[ (setf (elt newseq j) (elt sequence1 i1))
(incf i1))))
@s| (setf (elt newseq j) (elt sequence1 i1))
(setf i1 (f+ 1 i1)))))
@s]
****Change:(orig (693 693 c))
@s[ (setf (elt newseq j) (elt sequence1 i1))
(incf i1))
@s| (setf (elt newseq j) (elt sequence1 i1))
(setf i1 (f+ 1 i1)))
@s]
****Change:(orig (696 696 c))
@s[ (setf (elt newseq j) (elt sequence2 i2))
(incf i2)))))
@s| (setf (elt newseq j) (elt sequence2 i2))
(setf i2 (f+ 1 i2))))))
@s]